#lang racket
(define (atom? exp) (not (pair? exp)))
(define (make-cont num)
  (string->symbol (string-append "k" (number->string num))))
(define (cps-convert exp level)
  (if (atom? exp)
      `(,(make-cont level) ,exp)
      (case (car exp)
        ((set!) (cps-convert-set (cdr exp) level))
        ((if) (cps-convert-if (cdr exp) level))
        ((begin) (cps-convert-begin (cdr exp) level))
        ((lambda) (cps-convert-lambda (cdr exp) level))
        ((define) (cps-convert-define (cdr exp) level))
        (else 
         (cps-convert-application exp level)))))

(define (cps-convert-set exp level)
  (let ((name (car exp))
        (value (cadr exp))
        (cc (make-cont (+ level 1))))
    `(let ((,cc (lambda (v) (,(make-cont level) (set! ,name v)))))
       ,(cps-convert value (+ level 1)))))
(define (cps-convert-define exp level)
  (let ((name (car exp))
        (value (cadr exp))
        (cc (make-cont (+ level 1))))
    `(let ((,cc (lambda (v) (,(make-cont level) (define ,name v)))))
       ,(cps-convert value (+ level 1)))))

(define (cps-convert-if exp level)
  (let ((test (car exp))
        (etrue (cadr exp))
        (efalse (caddr exp)))
    `(let ((,(make-cont (+ level 1))
            (lambda (v)
              (if v
                  ,(cps-convert etrue level)
                  ,(cps-convert efalse level)))))
       ,(cps-convert test (+ level 1)))))

(define (cps-convert-begin exp level)
  (if (pair? exp)
      (if (null? (cdr exp))
          (cps-convert (car exp) level)
          `(let ((,(make-cont (+ level 1))
                  (lambda (v)
                    ,(cps-convert-begin (cdr exp) level))))
             ,(cps-convert (car exp) (+ level 1))))
      (if (not (null? exp))
          (error "wrong form of begin")
          `(,(make-cont level) scheme-null-object))))

(define (cps-convert-lambda exp level)
  (let ((args (car exp))
        (body (cdr exp)))
    `(,(make-cont level) (lambda ,(cons (make-cont (+ level 1)) args) ,(cps-convert-begin body (+ level 1))))))

(define (cps-convert-application exp level)
  (if (primitive? (car exp))
      (cps-convert-argument (car exp) (cdr exp) 0 level #t)
      (cps-convert-argument (car exp) (cdr exp) 0 level #f)))

(define (make-args number)
  (let loop ((i 0)
             (lst '()))
    (let ((v (string->symbol (string-append "v" (number->string i)))))
      (if (= i number)
          (reverse lst)
          (loop (+ i 1) (cons v lst))))))

(define (cps-convert-argument func args number level primitive?)
  (if (null? args)
      (if primitive?
          `(,(make-cont level) (,func ,@(make-args number)))
          (cond ((atom? func)
                 `(,func ,(make-cont level) ,@(make-args number)))
                ;;                ((eqv? (car func) 'lambda)
                ;;                 (error "not implement yet"))
                (else
                 `(let ((,(make-cont (+ level 1))
                         (lambda (v)
                           (v ,(make-cont level) ,@(make-args number)))))
                    ,(cps-convert func (+ level 1))))))
      `(let ((,(make-cont (+ level 1))
              (lambda ,(list (string->symbol (string-append "v" (number->string number))))
                ,(cps-convert-argument func (cdr args) (+ number 1) level primitive?))))
         ,(cps-convert (car args) (+ level 1)))))

(define (primitive? exp)
  (memv exp '(+ - * /)))

(define c-function-count 0)
(define c-function-list '())

(define *value* "value_register")
(define *env* "env_register")
(define *func* "func_register")

(define (c-store target value) (c target " = " value ";"))
(define (c-repr exp)
  (define symbol-map ;; map to create legal C names.
    '((#\- . #\_) (#\/ . #\S) (#\? . #\P) (#\> . #\G) (#\< . #\L) (#\= . #\E)
                  (#\! . #\1) (#\+ . #\A) (#\* . #\C) (#\/ . #\D) (#\% . #\F)))
  (define (symbol-fix str pos)
    (if (= pos (string-length str)) '()
        (let ((a (assoc (string-ref str pos) symbol-map)))
          (cons (if a (cdr a) (string-ref str pos))
                (symbol-fix str (+ 1 pos))))))
  (cond ((number? exp) (number->string (* 4 exp)))
        ((symbol? exp) (list->string (symbol-fix (symbol->string exp) 0)))
        ((char? exp) (number->string (* 4 (char->integer exp))))
        (else exp)))
(define (c . strs) ;; generalized string-append
  (define (str-app str1 rest)
    (if (null? rest) (if (string? str1) str1 (c-repr str1))
        (string-append (if (string? str1) str1 (c-repr str1)) 
                       (str-app (car rest) (cdr rest)))))
  (str-app (car strs) (cdr strs)))

(define (compile exp env)
  (if (atom? exp)
      (cond ((symbol? exp) (compile-symbol exp))
            ((number? exp) (c *value* "=" number ";"))
             
             
             
             (c *value* "=env_ref(" *env* ","  i "," j ");"))
            